home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / DIRECTOR.D < prev    next >
Encoding:
Modula Definition  |  1990-12-11  |  13.4 KB  |  350 lines
  1. DEFINITION MODULE Directory;
  2.  
  3. (*
  4.  * ---------------------------------------
  5.  *   Operationen auf Dateien und Ordnern
  6.  * ---------------------------------------
  7.  *
  8.  *     Z.B. Löschen, Umbenennen, Durchsuchen einzelner Ordner
  9.  *     oder Setzen/Abfragen der Standard-Pfade.
  10.  *     Auch Funktion zum Ermitteln der Texte für GEMDOS-Fehlernummern
  11.  *
  12.  * Zu den Namenskonventionen siehe Modul 'FileNames'!
  13.  *
  14.  * Die DTA ist die Adresse auf einen Puffer (hier "SearchRec" genannt), der
  15.  * von den GEMDOS-Funktionen "Fsfirst" und "Fsnext" verwendet wird, um
  16.  * darin interne sowie Anwender-Daten abzulegen. Werden "Fsfirst"-Aufrufe
  17.  * verschachtelt (bzw. die dabei angesprochenen Ordner), muß jeder Zugriff
  18.  * seinen eigenen Puffer verwenden.
  19.  * Viele Funktionen machen Gebrauch von "Fsfirst" und "Fsnext". 'DirQuery'
  20.  * sorgt selbst für ein korrektes Setzen der DTA. Die restlichen Funktionen
  21.  * ('FileExists', 'GetDirEntry', 'MakeFullPath', 'SearchFirst' und
  22.  * 'SearchNext') verwenden die aktuelle DTA. Vom Programmstart an ist
  23.  * immer automatisch eine gültige DTA eingestellt. Werden ausschließlich
  24.  * die hiesigen Funktionen
  25.  *   'FileExists', 'GetDirEntry', 'MakeFullPath' und 'DirQuery'
  26.  * verwendet, braucht man sich um die DTA nicht weiter kümmern. Lediglich,
  27.  * wenn 'SearchFirst' und 'SearchNext' verwendet werden, muß bei dazwischen
  28.  * erfolgenden Aufrufen von
  29.  *   'FileExists', 'GetDirEntry', 'MakeFullPath' oder einem erneuten
  30.  *   (verschachtelten) Aufruf von 'SearchFirst'
  31.  * die DTA zuvor neu gesetzt werden (siehe dazu 'GetDTA', 'SetDTA').
  32.  *
  33.  * Einige Funktionen haben einen 'result'-Parameter. Dieser dient dazu,
  34.  * evtl. während der Operation aufgetretene Fehler zu signalisieren.
  35.  * Ist der 'result'-Wert nach dem Aufruf negativ, ist ein Fehler aufgetreten.
  36.  * Die Fehlernummern entsprechen den in 'Files' verwendeten und sind im
  37.  * Modul 'MOSGlobals' definiert.
  38.  * Der Text zu den Fehlernummern kann mit der Funktion 'GetErrMsg' ermittelt
  39.  * werden (diese ist identisch mit 'GetStateMsg' aus 'Files').
  40.  *
  41.  * Alle Routinen, die einen Parameter vom Typ 'Drive' haben, können statt
  42.  * der Laufwerkskennung ('drvA', usw) auch einfach 'defaultDrv' übergeben,
  43.  * womit dann automatisch das Default-Laufwerk angesprochen wird.
  44.  *)
  45.  
  46. FROM SYSTEM     IMPORT BYTE, WORD;
  47. FROM MOSGlobals IMPORT FileStr, PathStr, DriveStr, NameStr, PfxStr, SfxStr,
  48.                        Time, Date, Drive, DriveSet;
  49.  
  50.  
  51. TYPE    (* Kennzeichen (Attribut) für einen Directory-Eintrag *)
  52.         FileAttr     = (readOnlyAttr,           (* Datei nicht beschreibbar *)
  53.                         hiddenAttr,             (* Eintrag unsichtbar *)
  54.                         systemAttr,             (* (Unsichtbare) Systemdatei *)
  55.                         volLabelAttr,           (* Diskname *)
  56.                         subdirAttr,             (* Subdirectory *)
  57.                         archiveAttr);           (* Archivierte Datei *)
  58.  
  59.         FileAttrSet  = SET OF FileAttr;
  60.  
  61.         (* Daten eines Directory-Eintrages *)
  62.         DirEntry     = RECORD
  63.                          name: NameStr;
  64.                          attr: FileAttrSet;
  65.                          time: Time;
  66.                          date: Date;
  67.                          size: LONGCARD
  68.                        END;
  69.  
  70.         SearchRec    = RECORD
  71.                          internal: ARRAY [0..20] OF BYTE;
  72.                          attr: FileAttrSet;
  73.                          time: CARDINAL;
  74.                          date: CARDINAL;
  75.                          size: LONGCARD;
  76.                          name: ARRAY [0..13] OF CHAR;
  77.                        END;
  78.  
  79.         DTA          = POINTER TO SearchRec;  (* "Disk Transfer Address" *)
  80.  
  81.  
  82.         DirQueryProc = PROCEDURE ( REF (* path: *) ARRAY OF CHAR,
  83.                                        (* entry:*) DirEntry      ): BOOLEAN;
  84.  
  85. CONST   (* Für Funktionen DirQuery und SearchFirst: *)
  86.         QueryFiles = FileAttrSet {};            (* Nur Dateien *)
  87.         QueryAll   = FileAttrSet {subdirAttr};  (* Dateien & Ordner *)
  88.     (* "QueryFolders" unterstützt GEMDOS leider nicht *)
  89.  
  90.  
  91.  
  92. PROCEDURE Delete (REF name: ARRAY OF CHAR; VAR result: INTEGER);
  93.   (*
  94.    * Löscht eine Datei, kein Subdirectory.
  95.    *
  96.    * Wenn Datei nicht vorhanden, liefert 'result' den positiven
  97.    * Wert 'MOSGlobals.fNotDeleted'
  98.    *)
  99.  
  100. PROCEDURE Rename (REF fromName, toName: ARRAY OF CHAR; VAR result: INTEGER);
  101.   (*
  102.    * Benennt Datei von 'fromName' nach 'toName' um.
  103.    * (Ab TOS 1.4 können hiermit auch Ordnernamen geändert werden)
  104.    *
  105.    * Wenn Zieldatei existiert, wird 'MOSGlobals.fFileExists' (negativer Wert)
  106.    * geliefert und der Name nicht geändert; ggf. vorher 'Delete (toName)'
  107.    * aufrufen.
  108.    *)
  109.  
  110.  
  111. PROCEDURE FileExists ( REF fileName: ARRAY OF CHAR ): BOOLEAN;
  112.   (*
  113.    * Liefert TRUE, wenn die angegebene Datei existiert.
  114.    * Liefert nicht TRUE bei evtl. existierenden Ordnern!
  115.    *)
  116.  
  117. PROCEDURE PathExists ( REF path: ARRAY OF CHAR ): BOOLEAN;
  118.   (*
  119.    * Liefert TRUE, wenn der angegebene Pfad existiert.
  120.    * Wird ein Dateiname mitsamt eines Pfades angegeben, wird nur der
  121.    * Pfad geprüft, nicht das Vorhandensein der Datei selbst.
  122.    *)
  123.  
  124.  
  125. PROCEDURE GetFileAttr ( REF filename: ARRAY OF CHAR;
  126.                         VAR attr: FileAttrSet; VAR result: INTEGER );
  127.   (*
  128.    * Ermittelt Dateikennzeichen (Attribut) einer Datei (nicht Ordner!).
  129.    *
  130.    * Attribute von anderen Directory-Einträgen können mit 'GetDirEntry'
  131.    * ermittelt werden.
  132.    *)
  133.  
  134. PROCEDURE SetFileAttr ( REF filename: ARRAY OF CHAR; attr: FileAttrSet;
  135.                         VAR result: INTEGER );
  136.   (*
  137.    * Setzt Dateikennzeichen (Attribut) einer Datei.
  138.    *)
  139.  
  140. PROCEDURE GetDirEntry ( REF name: ARRAY OF CHAR;
  141.                         VAR entry: DirEntry; VAR result: INTEGER );
  142.   (*
  143.    * Liefert den Directory-Eintrag einer Datei oder Ordner in 'entry'.
  144.    *)
  145.  
  146. (*$H+*)
  147. PROCEDURE DirQuery (REF wildcard: ARRAY OF CHAR;
  148.                         select  : FileAttrSet;
  149.                         dirProc : DirQueryProc;
  150.                     VAR result  : INTEGER);
  151.   (*
  152.    * Liefert alle Dateien/Ordnernamen aus einem Ordner.
  153.    *
  154.    * Ruft 'dirProc' wiederholt für alle zu 'wildcard' passenden Directory-
  155.    * einträgen auf, solange 'dirProc' TRUE liefert.
  156.    * Wegen $H+ können auch lokale Prozeduren an 'dirProc' übergeben werden.
  157.    * Beispiele für 'wildcard' siehe Funktion 'NameMatching' weiter unten.
  158.    * Für 'select' bieten sich v.A. die folg. Konstanten an:
  159.    *  'QueryFiles' findet alle Dateien, keine Ordner und keine Volume-Labels;
  160.    *  'QueryAll' findet alle Dateien und Ordner, keine Volume-Labels;
  161.    *  'FileAttrSet {volLabelAttr}' findet nur Volume-Labels (uninteressant);
  162.    *
  163.    * Ist das Verzeichnis leer bzw. treffen keine Dateien auf den 'wildcard'
  164.    * zu, liefert 'result' den positiven Wert 'fNoMatchingFiles'.
  165.    *
  166.    * Diese Funktion ist Re-entrant-fähig, sie kann also innerhalb der 'dirProc'
  167.    * wiederum aufgerufen werden.
  168.    *)
  169.  
  170.  
  171. PROCEDURE SetDefaultPath ( REF path: ARRAY OF CHAR; VAR result: INTEGER );
  172.   (*
  173.    * Setzt den Default-Pfad des aktuellen Laufwerks. Ist in 'path' eine
  174.    * Laufwerkskennung enthalten, wird dieses Laufwerk auch zum Aktuellen.
  175.    *)
  176.  
  177. PROCEDURE GetDefaultPath ( VAR path: ARRAY OF CHAR );
  178. PROCEDURE DefaultPath (): PathStr;
  179.   (*
  180.    * Beide Funktionen liefert den Default-Pfad, also Laufwerkskennung
  181.    * (wie bei 'DefaultDrive') und aktuellen Pfad des Laufwerks (wie bei
  182.    * 'GetCurrentDir').
  183.    *)
  184.  
  185.  
  186. PROCEDURE CreateDir ( REF path: ARRAY OF CHAR; VAR result: INTEGER );
  187.   (*
  188.    * Legt einen neuen Ordner an.
  189.    *)
  190.  
  191. PROCEDURE DeleteDir ( REF path: ARRAY OF CHAR; VAR result: INTEGER );
  192.   (*
  193.    * Löscht einen Ordner. Er muß dazu leer sein!
  194.    *)
  195.  
  196.  
  197. PROCEDURE GetCurrentDir ( driveNo: Drive; VAR path: ARRAY OF CHAR );
  198.   (*
  199.    * Liefert den aktuellen Pfad eines Laufwerks.
  200.    *
  201.    * Liefert den Pfadnamen des Laufwerks 'driveNo', der angesprochen wird,
  202.    * wenn in einem Pfadnamen nicht vom Root-Directory ausgegangen wird
  203.    * (also wenn ein Pfadname z.B. "HU.GO" oder "B:ABC.E", aber nicht
  204.    * "\HU.GO" bzw. "B:\ABC.E" ist).
  205.    * Der Pfad wird immer mit einem '\' (Backslash) abgeschlossen, beim
  206.    * Root-Dir (Hauptverzeichnis) wird nur '\' geliefert.
  207.    * Entgegen der Angaben im Handbuch wird nie der Laufwerksbuchstabe
  208.    * mitgeliefert. Dieser kann einfach durch Aufruf von 'DriveToStr (driveno)'
  209.    * ermittelt werden (Beim akt. Laufwerk nehme man die einfachere Funktion
  210.    * 'GetDefaultPath').
  211.    * 'path' sollte mindestens 128 Zeichen groß sein.
  212.    *)
  213.  
  214. PROCEDURE SetCurrentDir ( driveNo: Drive; REF path: ARRAY OF CHAR;
  215.                           VAR result: INTEGER );
  216.   (*
  217.    * Setzt den aktuellen Pfad eines Laufwerks.
  218.    *
  219.    * Anm.: Der Fehler des GEMDOS, daß nur der Pfad des aktuellen Laufwerks
  220.    *       bestimmbar ist, tritt bei dieser Funktion nicht in Erscheinung.
  221.    *)
  222.  
  223.  
  224. PROCEDURE DrivesOnline (): DriveSet;
  225.   (*
  226.    * Liefert ein SET aller ansprechbaren Laufwerke.
  227.    *)
  228.  
  229. PROCEDURE SetDefaultDrive ( driveNo: Drive );
  230.   (*
  231.    * Setzt das Laufwerk, das angesprochen wird, wenn in einem Pfadnamen
  232.    * kein Laufwerk angegeben wird (= Default-Laufwerk).
  233.    * 'driveNo':='defaultDrv' wird ignoriert.
  234.    *)
  235.  
  236. PROCEDURE DefaultDrive (): Drive;
  237.   (*
  238.    * Liefert das Default-Laufwerk, liefert nie 'defaultDrv'.
  239.    *)
  240.  
  241. PROCEDURE FreeSpace ( driveNo: Drive ): LONGCARD;
  242.   (*
  243.    * Liefert noch freien Platz des Laufwerks in Bytes.
  244.    * Liefert Null, wenn Laufwerk nicht ansprechbar.
  245.    * Durchführung kann u.U. mehrere Sekunden dauern.
  246.    *)
  247.  
  248.  
  249. PROCEDURE MakeFullPath ( VAR pathOrFileName: ARRAY OF CHAR;
  250.                          VAR result: INTEGER );
  251.   (*
  252.    * prüft, ob der angegebene Pfad existiert und vervollständigt ihn
  253.    * ggf. zu einem kompletten Pfadnamen aus Laufwerksbuchstaben und
  254.    * ganzem Pfad.
  255.    * Zudem wird der Name ggf. in Großbuchstaben umgewandelt.
  256.    *
  257.    * Tritt ein Fehler auf ('result' < 0), bleibt 'pathOrFileName' unverändert.
  258.    *
  259.    * Es kann wahlweise nur der Pfad (muß dann mit '\' oder ':' abschließen,
  260.    * z.B., indem vorher 'ValidatePath' aufgerufen wird) oder ein Dateiname
  261.    * (mit oder ohne Pfad) angegeben werden.
  262.    * Der Pfad muß beim Aufruf tatsächlich erreichbar (vorhanden) sein, da
  263.    * in jedem Fall dieser Pfad zur Prüfung angesprochen wird. Wird ein
  264.    * Dateiname angegeben, braucht diese nicht zu existieren - auf sie wird
  265.    * nicht zugegriffen.
  266.    * Ist der Pfad nicht erreichbar, liefert 'result' entsprechend einen
  267.    * negativen Wert als Fehlerkennung.
  268.    *
  269.    * Beispiele (der aktuelle Pfad sei "D:\TEST\DATEN\"):
  270.    *   'D001.DAT'           ergibt  'D:\TEST\DATEN\D001.DAT'
  271.    *   '..\D001.DAT'        ergibt  'D:\TEST\D001.DAT'
  272.    *   'D:\D001.DAT'        ergibt  'D:\D001.DAT'
  273.    *   ''                   ergibt  'D:\TEST\DATEN\'
  274.    *   'BIN\'               ergibt  'D:\TEST\DATEN\BIN\'
  275.    *   'D:\BLA\D001.DAT'    liefert -34 in 'result', falls der Ordner 'BLA'
  276.    *                          nicht existiert.
  277.    *)
  278.  
  279.  
  280. PROCEDURE GetDTA ( VAR dta: DTA );
  281.   (*
  282.    * Ermittelt die aktuelle DTA
  283.    *)
  284.  
  285. PROCEDURE SetDTA ( dta: DTA );
  286.   (*
  287.    * Setzt eine neue DTA. Dazu muß 'dta' auf einen Puffer von mind. 44 Byte
  288.    * ('SearchRec') zeigen.
  289.    *)
  290.  
  291. PROCEDURE SearchFirst ( REF wildcard: ARRAY OF CHAR;
  292.                             select  : FileAttrSet;
  293.                         VAR result  : INTEGER );
  294.  
  295. PROCEDURE SearchNext  ( VAR result  : INTEGER );
  296.   (*
  297.    * Funktionen wie 'Dirquery'. Hierbei wird jedoch keine Prozedur angegeben,
  298.    * die für alle Directory-Einträge aufgerufen wird, sondern es muß selbst
  299.    * eine Schleife gebildet werden und auch die DTA ggf. neu gesetzt werden
  300.    * (s.o.).
  301.    *
  302.    * Sobald keine auf 'wildcard' zutreffenden Dateien mehr gefunden werden,
  303.    * wird 'fNoMoreFiles' (-49) in 'result' geliefert. Dieser Wert wird also
  304.    * auch schon bei 'SearchFirst' geliefert, wenn überhaupt keine Dateien
  305.    * zutreffen. Dem gegenüber liefert die Original-GEMDOS-Funktion "Fsfirst"
  306.    * dann den Wert 'fFileNotFound' (-33) und erst "Fsnext" würde -49 liefern.
  307.    *
  308.    * Beispiel:
  309.    *   VAR  dta: DTA;  entry: DirEntry;
  310.    *   BEGIN
  311.    *     NEW (dta);
  312.    *     SetDTA (dta);
  313.    *     SearchFirst ('*.*', QueryFiles, result);
  314.    *     WHILE result # fNoMoreFiles DO
  315.    *       GetDTAEntry (dta, entry);
  316.    *       ... Operationen mit 'entry'...
  317.    *       SearchNext (result)
  318.    *     END;
  319.    *)
  320.  
  321. PROCEDURE GetDTAEntry ( dta: DTA; VAR entry: DirEntry );
  322.   (*
  323.    * Wandelt die 'SearchRec'-Daten einer DTA in einen 'DirEntry'.
  324.    * Es ist jedoch ebenso möglich, auf die SearchRec-Daten direkt zuzugreifen,
  325.    * Datum und Zeit ('date', 'time') können dann beispielsweise mit Hilfe
  326.    * von 'Clock.UnpackDate/Time' in die üblichen Records umgewandelt werden.
  327.    *)
  328.  
  329.  
  330. PROCEDURE ForceMediaChange ( driveNo: Drive );
  331.   (*
  332.    * Simuliert einen Disk-Wechsel auf dem angegebenen Laufwerk,
  333.    * sodaß beim nächsten Disk-Zugriff mit Sicherheit alle Daten
  334.    * neu von der Disk eingelesen werden (die evtl. vom TOS/GEMDOS
  335.    * gepufferten Daten werden ignoriert).
  336.    * Diese Funktion wurde nach einer Anleitung von Atari
  337.    * (TOS Release Notes v. 20. Mai 1988) implementiert und ist
  338.    * damit verläßlich für alle TOS-Versionen anwendbar.
  339.    *)
  340.  
  341.  
  342. PROCEDURE GetErrMsg ( number: INTEGER; VAR errMsg: ARRAY OF CHAR );
  343.   (*
  344.    * Liefert in 'msg' einen String (Höchstlänge 32 Zeichen), der eine
  345.    * Beschreibung der zugehörigen Fehlernummer 'number' enthält.
  346.    * Funktion ist identisch mit 'Files.GetStateMsg'.
  347.    *)
  348.  
  349. END Directory.
  350.